Формы, компоненты

Давайте создадим.

Сущность свойства Owner в том, что перед уничтожением владельца, он уничтожает (через Free) принадлежащие ему объекты. Таким образом, все зависит от того, кому Вы хотите доверить уничтожение созданных форм/компонентов. В частности, если Вы сами будете этим заниматься, то AOwner может быть, например, nil.

Для того, чтобы созданный компонент появился на экране, надо указать его родителя, заполнив свойство Parent, например:

NewButton.Parent := Form1;

Пример кода, обрабатывающего события от свежесозданных компонентов:

type

TForm1 = class(TForm)

{ ... }

private

{ эта процедура будет вызываться при нажатии на кнопку }

procedure ButtonClicked(Sender : TObject);

public

{ в этой процедуре происходит создание кнопки }

procedure CreateButton;

end;

{ ... }

procedure TForm1.CreateButton;

var

Btn : TButton;

begin

Btn := TButton.Create(Self); { Уничтожать кнопку будет форма }

Btn.Parent := Self; { Родителем кнопки будет форма }

Btn.OnClick := ButtonClicked; { Процедура, которая будет исполняться при }

Btn.Visible := true; { нажатии на кнопку }

end;

Как в TTreeView построить дерево открытых окон?

Alex Shakhajlo 14 февраля 1999 г
Alex.Shakhajlo@f701.n461.z2.fidonet.org

Мне стало интересно построить дерево окон и вот что у меня получилось:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, HistEdit, Buttons, StdCtrls, ColoredGrid, TLHelp32, ComCtrls;

type

TForm1 = class(TForm)

List : TTreeView;

procedure FormCreate(Sender : TObject);

private

{ Private declarations }

procedure listlevel(N : TTreeNode; H : HWND);

public

{ Public declarations }

end;

var

Form1 : TForm1;

implementation

{$R *.DFM}

procedure TForm1.ListLevel;

var

B : array[0..128] of char;

S : String;

T : TTreeNode;

C, W : HWND;

begin

W := H;

while W <> 0 do

begin

GetClassName (W, @B, 128);

S := StrPas(B);

GetWindowText(W, @B, 128);

S := S + '(' + StrPas(B) + ')';

T := List.Items.AddChild(N, S);

C := GetWindow(W, GW_CHILD);

ListLevel(T, C);

W := GetNextWindow(W, GW_HWNDNEXT);

end;

procedure TForm1.FormCreate(Sender : TObject);

var

H : HWnd;

begin

H := GetDeskTopWindow;

ListLevel(nil, H);

end;

end.

Как заставить клавишу "Enter" вести себя как "Tab" в DBGrid?

Следующий пример включает также обработку "Enter" для всей формы, включая поля и т.д. Часть, относящаяся к DBGrid обрабатывается в секции Else. Приведенный код не полностью копирует поведение "Tab" в DBGrid, с последней колонки фокус переходит на первую без перехода на следующую запись.

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

{ Это обработчик события OnKeyPress для ФОРМЫ! }

{ Требуется так же установить св-во KeyPreview в True }

begin

if Key = #13 then { клавиша }

if not (ActiveControl is TDBGrid) then

begin { если не в TDBGrid }

Key := #0; { убрать }

Perform(WM_NEXTDLGCTL, 0, 0); { перейти дальше }

end

else

if (ActiveControl is TDBGrid) then { если в TDBGrid }

with TDBGrid(ActiveControl) do

if SelectedIndex < (FieldCount - 1) then { следующее поле }

SelectedIndex := SelectedIndex + 1

else

SelectedIndex := 0;

end;

Как узнать, какая ячейка при просмотре TDBGrid текущая?

Здесь процедура для сохранения текущего номера строки и колонки. Следующий код в методе MyDBGridDrawDataCell обновляет переменные Col и Row (которые не должны быть локальными для этого метода) каждый раз, когда таблица перерисовывается. Используя этот код, Вы можете считать, что Col и Row указывают на текущую колонку и строку соответственно.

var

Col, Row : Integer;

procedure TForm1.MyDBGridDrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);

var

RowHeight : Integer;

begin

if gdFocused in State then

begin

RowHeight := Rect.Bottom - Rect.Top;

Row := (Rect.Top div RowHeight) - 1;

Col := Field.Index;

end;

Как использовать Clipboard для переноса данных в собственном формате?

Не только возможно, именно так поступают функции Clipboard.GetComponent и Clipboard.SetComponent.

Сперва Вы должны зарегистрировать свой собственный формат данных для Clipboard с помощью функции RegisterClipboardFormat():

CF_MYFORMAT := RegisterClipboardFormat('My Format Description');

Далее вы должны выполнить эти шаги : 1. Создать поток (memory stream) и записать туда данные.
2. Создать глобальный буфер в памяти и скопировать поток туда.
3. Вызвать Clipboard.SetAsHandle(), чтобы поместить буфер в clipboard.

Пример:

var

HBuf : THandle;

BufPtr : Pointer;

MStream : TMemoryStream;

begin

MStream := TMemoryStream.Create;

try

{-- Write your data to the stream. --}

HBuf := GlobalAlloc(GMEM_MOVEABLE, MStream.Size);

try

BufPtr := GlobalLock(HBuf);

try

Move(MStream.Memory^, BufPtr^, MStream.Size);

Clipboard.SetAsHandle(CF_MYFORMAT, HBuf);

finally

GlobalUnlock(HBuf);

end;

except

GlobalFree(HBuf);

raise;

end;

finally

MStream.Free;

end;

ВНИМАНИЕ: Не уничтожайте буфер, созданный с GlobalAlloc(). Поскольку Вы поместили его в Clipboard, это уже дело Clipboard'а его уничтожить. Опять же, получая буфер из Clipboard, не уничтожайте этот буфер - просто сделайте копию содержимого.

Для обратного получения потока и данных, сделайте что-нибудь вроде этого:

var

HBuf : THandle;

BufPtr : Pointer;

MStream : TMemoryStream;

begin

HBuf := Clipboard.GetAsHandle(CF_MYFORMAT);

if HBuf <> 0 then

begin

BufPtr := GlobalLock(HBuf);

if BufPtr <> nil then

begin

try

MStream := TMemoryStream.Create;

try

MStream.WriteBuffer(BufPtr^, GlobalSize(HBuf));

MStream.Position := 0;

{-- Read your data from the stream. --}

finally

MStream.Free;

end;

finally

GlobalUnlock(HBuf);

end;

Как перевести визуальный компонент, такой, как TPanel, в состояние перемещения (взять и перенести)?

Borland TI N2909 (перевод: Акжан Абдулин) 5 января 1999 г

Пример:

{ В случае Panel1 : TPanel - обработчик события OnMouseDown }

procedure TForm1.Panel1MouseDown(Sender : TObject; Button : TMouseButton;

Shift : TShiftState; X, Y : Integer);

const

SC_DRAGMOVE = $F012; { a magic number }

begin

ReleaseCapture;

P.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);

end;

Как изменить внешний вид хинтов (всплывающих подсказок)?

Dmitry Medved 5 января 1999 г

1. Создаем свой класс - потомок от THintWindow

type

TCustomHint = class(THintWindow)

public

constructor Create(AOwner: TComponent); override;

end;

Пpимечание

Этот способ не позволит изменить цвет шpифта - для этого пpидется пеpекpывать метод Paint;

Если пеpекpыть CreateParams, то можно, напpимеp, наpисовать Hint в фоpме облачка.

2. Меняем фонт:

constructor TCustomHint.Create(AOwner : TComponent);

begin

inherited Create(AOwner);

with Canvas.Font do // Именно так, а не пpосто Font!

begin

Name := 'Times New Roman Cyr';

Style := [fsBold, fsItalic];

Size := 40;

end;

3. Устанавливаем новый хинт

procedure TForm1.FormCreate(Sender : TObject); // Это может быть любой обpаботчик

begin

HintWindowClass := TMyHint; // Устанавливаем глобальную пеpеменную

Application.ShowHint := False; // Application.FHintWindow.Free

Application.ShowHint := True; // Application.FHintWindow.Create

end;

Литеpатуpа:
1. <...>\Source\VCL\Forms.pas (TApplication).
2. <...>\Source\VCL\Controls.pas (THintWindow).
3. Delphi Help (OnShowHint, THintInfo).

Как изменить цвет фона и шрифта в TDBGrid в зависимости от содержимого?

Kuznetsov Anatoly 5 января 1999 г
triton@cs.sibgarw.nsk.su

Для изменения в TDBGrid цвета фона и шрифта в зависимости от содержимого определенного поля (ячейки) необходимо воспользоваться обработчиком события onDrawColumnCell. Представим что мы хотим чтобы все записи где сумма = 0 высвечивались на красном фоне синим курсивом. Для этого в обработчик onDrawColumnCell добавляем следующий код:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

with DBGrid1.Canvas do

begin

if (Table1.FieldByName('summa').asString = '0') and not (gdFocused in State) then

begin

Brush.Color := clRed;

Font.Color := clBlue;

Font.Style := [fsBold,fsItalic];

FillRect(Rect);

TextOut(Rect.Left, Rect.Top, Column.Field.Text);

end

else

DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

А вот для закраски только определенной ячейки введите следующий код в обработчике события OnDrawDataCell:

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);

begin

if gdFocused in State then

with (Sender as TDBGrid).Canvas do

begin

Brush.Color := clRed;

FillRect(Rect);

TextOut(Rect.Left, Rect.Top, Field.AsString);

end;

Установите свойство DefaultDrawing в True. Если установить DefaultDrawing в False, то Вы должны самостоятельно перерисовать все ячейки аналогично примеру.

Как добавить горизонтальную полосу прокрутки в TListBox?

Akzhan Abdulin 3 января 1999 г
Akzhan.Abdulin@f55.n5040.z2.fidonet.org

Компонент VCL TListBox автоматически реализует вертикальную полосу прокрутки. Полоска прокрутки появляется, когда окно списка слишком мало для показа всех элементов списка. Однако окно списка не показывает горизонтальной полосы прокрутки, когда какие-либо элементы списка имеют большую ширину, чем само окно списка. Конечно, есть возможность добавить горизонтальную полосу прокрутки. Добавьте следующий код в обработчик события OnCreate Вашей формы:

procedure TForm1.FormCreate(Sender : TObject);

var

I, MaxWidth : Integer;

begin

MaxWidth := 0;

for I := 0 to ListBox1.Items.Count - 1 do

if MaxWidth < ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[I]) then

MaxWidth := ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[I]);

SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth + 2, 0);

end;

Этот код находит ширину, в пикселах, самой длинной строки в окне списка. Затем он использует сообщение LB_SETHORIZONTALEXTENT для установки горизонтальной прокручиваемой ширины, в пикселах, для окна списка. Два дополнительных пиксела добавлены к MaxWidth, чтобы сдвинуть оконечные символы от правой границы окна списка.

Как создать окна непрямоугольной формы и работать с ними?

Alexander Burnashov 3 января 1999 г
alex@arta.spb.su

Попpобуйте вот этот обpаботчик OnCreate. Hа меня это пpоизвело впечатление.:


procedure TForm1.FormCreate(Sender : TObject);
const 
  W = 36 * PI / 180;
var
  R, R1, R2 : HRgn; 
  X, Y, I : Integer;

  function S(A : Integer; R : Integer) : Integer;
  begin
    Result := round(R * sin(W * A));
  end;

  function C(A : Integer; R : Integer) : Integer;
  begin
    Result := round(R * cos(W * A));
  end;

  function GetStarReg(X, Y, R : Integer) : HRGN;
  var  
    P : array[0..4] of TPoint;
  begin
    P[0] := Point(X, Y - R);
    P[1] := Point(X - S(4, R), Y - C(4, R));
    P[2] := Point(X - S(8, R), Y - C(8, R));
    P[3] := Point(X - S(2, R), Y - C(2, R));
    P[4] := Point(X - S(6, R), Y - C(6, R));
    Result := CreatePolygonRgn(P, 5, WINDING);
  end;

begin
  X := Width div 2;
  Y := Height div 2;
  R := GetStarReg(X, Y, 100);
  I := 1;
  repeat
    R1 := GetStarReg(X - S(I, 120), Y - C(I, 110), 40);
    CombineRgn(R, R, R1, RGN_OR);
    inc(I, 2);
  until I > 9;
  R1 := GetStarReg(X, Y, 30);
  CombineRgn(R, R, R1, RGN_DIFF);
  R1 := CreateEllipticRgn(3, 3, Width - 6, Height - 6);
  R2 := CreateEllipticRgn(20, 10, Width - 20, Height - 10);
  CombineRgn(R1, R1, R2, RGN_DIFF);
  CombineRgn(R, R, R1, RGN_OR);
  SetWindowRgn(Handle, R, True);
end;

Как обратится из одной модальной формы к другой - не активной?

Serge Buzadzhy 2 января 1999 г

Предлагаю вот такой способ:


procedure ShowAlmostModal(FormModal : TForm);
begin
  NavigatorForm.Enabled := False;
  FormModal.ShowModal
end;

     И вот это пpивесь на OnShow  почти модальной  фоpмы

procedure FormShow(Sender : Tobject);
begin
  NavigatorForm.Enabled := True;
end;

Как добавить свой пункт в системное меню формы?

Aleksey Moshkin 25 декабря 1998 г
Aleksey.Moshkin@p4.f24.n5010.z2.fidonet.org

Предлагаю стандартный способ:

var

SMenu : THandle;

begin

SMenu := GetSystemMenu(Handle, False);

InsertMenu(SMenu, 1, MF_Byposition, ID_NEW, 'NEW');

end;

Выгружать элемент меню по завершению работы программы не надо.
Подобное использование требует как правило написания обработчика сообщения.

Как с помощью TDBGrid.RowSelected получить доступ к записям TTable, соответствующим строкам, помеченным в TDBGrid?

Michail Alyavdin 17 декабря 1998 г
boss@vast.spb.su

Предлагаю часть из своей работающей процедуры:

Пользователь отмечает (или нет) на DBGrid некоторое число записей, а эта процедура перегоняет их в структуру SData.

with CData.SpTable, SData do

begin

nSpData := DBGrid1.SelectedRows.Count;

if nSpData > MaxnSpData then nSpData := MaxnSpData;

if nSpData = 0 then

begin

nSpData := 1;

GetSpectr(1, SData);

end

else

begin

DisableControls;

try

for I := nSpData downto 1 do

begin

Bookmark := DBGrid1.SelectedRows.Items[I - 1];

GetSpectr(I, SData);

end;

finally

EnableControls;

end;

Можно ли задать формат/маску вывода числа в столбце DBGrid?

Ivanuts Vasiliy 6 декабря 1998 г
ivanuts@altavista.net

По скольку речь идет о компоненте TDBGrid, то нельзя забывать что, ячейки этого компонента заполняются данными из полей таблицы базы данных через компонент TDataSource. А именно составляющими являются автоматически созданные по "подобию и количеству" полей таблицы - компоненты TField. В свою очередь, компонент TField имеет унаследованое от класса TCustomMaskEdit свойство DisplayFormat, которое и отвечает за форматное представление данных в других визуальных компонентах, в том числе и в TDBGrid. Важно знать что, для настройки этого свойства средствами визуальной разработки - необходимо явно создать в классе Вашей формы поля типа TField. Это можно сделать при помощи Редактора полей компонентов TTable или TQuery. Форматная строка в этом свойстве может быть выбрана по правилам форматирования данных, на пример:

'#,##0.00' выдаст результат = 94 256,00

Использование обработчика OnHint при наличии нескольких форм.

В Online Help и в Visual Component Library Reference описан пример обработчика события OnHint объекта TApplication. Пример показывает, как можно использовать панель для отображения подсказок (hint), связанных с другими компонентами. В примере обработчик OnHint устанавливается во время обработки события OnCreate для формы; в программе, включающей более чем одну форму, будет трудно использовать эту технику. Перемещение присваивания обработчика OnHint из события OnCreate формы в событие OnActivate позволит различным формам данного приложения работать с подсказками, как им нужно. Ниже приведен измененный пример из OnLine Help и VCL Reference.

type

TForm1 = class(TForm)

Button1 : TButton;

Panel1 : TPanel;

Edit1 : TEdit;

procedure FormActivate(Sender : TObject);

private

{ Private declarations }

public

procedure DisplayHint(Sender: TObject);

end;

implementation

{$R *.DFM}

procedure TForm1.DisplayHint(Sender : TObject);

begin

Panel1.Caption := Application.Hint;

end;

procedure TForm1.FormActivate(Sender : TObject);

begin

Application.OnHint := DisplayHint;

end;

Переход на другую страницу TabSet по имени.

Поместите Tabset(TabSet1) и Edit (Edit1) на форму. Добавьте 4 страницы в TabSet - свойство Tabs: Hello, World, Of, Delphi. Напишите обработчик OnChange для Edit:

procedure Tform1.Edit1Change(Sender: TObject);

var

I : Integer;

begin

for I:= 0 to TabSet1.Tabs.Count - 1 do

if Edit1.Text = TabSet1.Tabs[I] then

TabSet1.TabIndex := I;

end;

Если набрать любое имя в Edit1, фокус установится на соответствующую страницу.

Как выполнить UnDo в Memo.

Если определено всплывающее(pop-up) меню для TMemo,и заданы клавиши для операций Cut,Copy, Paste, то вы можете обрабатывать эти события вызывая CuttoClipBoard, CopytoClipBoard, и т.д. Однако, если Вы поместили пункт Undo в меню (обычно Ctrl+Z), то как дать знать TMemo, что нужно выполнить Undo? Встроенного Undo для этого достаточно:

Memo1.Perform(EM_UNDO, 0, 0);

Для переключения enable/disable опции undo:

Undo1.Enabled := Memo1.Perform(EM_CANUNDO, 0, 0)<> 0;

Как можно определить, на какой строке в TMemo находится курсор?

Весь фокус в сообщении em_LineFromChar. Попробуйте:

procedure TmyForm.BitBtn1Click(Sender: TObject);

var

iLine : Integer ;

begin

iLine := Memo1.Perform(em_LineFromChar, $FFFF, 0);

{ Внимание: номера строк начинаются с нуля }

MessageDlg('Line Number: ' + IntToStr(iLine), mtInformation, [mbOK], 0 ) ;

end;

Обработка исключительных ситуаций (exceptions) EDBEngineError.

Информация об ошибке BDE может быть получена для использования в приложении из EDBEngineError. Исключительная ситуация EDBEngineError обрабатывается в программе с помощью конструкции try ... except. Когда возникает исключительная ситуация BDE, то может быть создан объект EDBEngineError и различные поля этого объекта могут быть использованы для программного определения, что не в порядке и что требуется для исправления ситуации. Далее, для данной исключительной ситуации может быть сгенерировано несколько сообщений об ошибках. Это требует организации перебора сообщений об ошибках для получения нужной информации. Поле, наиболее важное для данного контекста - ErrorCount : Integer; показывает количество ошибок в свойстве Errors; счет начинается с нуля. Errors : TDBError; набор записей, которые содержат информацию о каждой полученной ошибке; доступ к записям происходит по индексу типа Integer. Errors.ErrorCode : DBIResult; показывает номер ошибки BDE для текущей записи об ошибках в свойстве Errors.

Errors.Category : Byte;//категория ошибки, относящаяся к полю ErrorCode.
Errors.SubCode : Byte;//подкод (subcode) для значения в ErrorCode.
Errors.NativeError : LongInt;//код удаленной ошибки, возвращаемый сервером; если ноль, то это ошибка не сервера; возвращаемое SQL запросом значение появляется в данном поле.
Errors.Message : TMessageStr; //сообщение об ошибке, сервера или BDE

В конструкции try..exceptобъект создается напрямую в разделе except. После создания можно работать поля обычным образом или передавать объект в другую роцедуру для исследования ошибки. Кроме того, можно создать свой собственный компонент для использования в данных целях; его набор функциональных возможностей можно легко переносить между приложениями. В примере ниже во время возникновения исключительной ситуации BDE создается объект DBEngineError, передается в процедуру и анализируется для выделения информации об ошибке. В конструкции try..except, объект DBEngineError можно создать с помощью синтаксиса, приведенного ниже:

procedure TForm1.Button1Click(Sender : TObject);

var

I : Integer;

begin

if Edit1.Text > ' ' then

begin

Table1.FieldByName('Number').AsInteger := StrToInt(Edit1.Text);

try

Table1.Post;

except

on E: EDBEngineError do

ShowError(E);

end;

В этой процедуре делается попытка изменить значение поля в таблице и затем вызывается метод Post соответствующей таблицы. В конструкцию try..except заключается только попытка Post. Если при этом возникает ошибка BDE, то выполняеся секция except, в которой создается объект E типа EDBEngineError и затем E передается в процедуру ShowError. Заметьте, что только EDBEngineError учитывается в данной конструкции. В реальной ситуации нужно, скорее всего, проверять и другие виды исключительных ситуаций. Процедура ShowError принимает объект EDBEngineError, передаваемый в качестве параметра и исследует содержащиеся сообщения об ошибках. В данном примере информация об ошибках показывается в компоненте TMemo. Первый шаг состоит в определении количества действительно возникших ошибок. Для этого служит свойство ErrorCount. После того, как стало известно количество ошибок, можно использовать цикл для доступа к каждой записи об ошибке в свойстве Error и помещению информацию о них в TMemo.

procedure TForm1.ShowError(AExc : EDBEngineError);

var

I : Integer;

begin

Memo1.Lines.Clear;

Memo1.Lines.Add('Number of errors: ' + IntToStr(AExc.ErrorCount));

Memo1.Lines.Add('');

{Iterate through the Errors records}

for i := 0 toAExc.ErrorCount - 1 do

begin

Memo1.Lines.Add('Message: ' + AExc.Errors[i].Message);

Memo1.Lines.Add(' Category: ' + IntToStr(AExc.Errors[i].Category));

Memo1.Lines.Add(' Error Code: ' + IntToStr(AExc.Errors[i].ErrorCode));

Memo1.Lines.Add(' SubCode: ' + IntToStr(AExc.Errors[i].SubCode));

Memo1.Lines.Add(' Native Error: ' + IntToStr(AExc.Errors[i].NativeError));

Memo1.Lines.Add('');

end;

Как открыть ComboBox программно.

У ComboBox есть run-time свойство, не упомянутое в On-Line Help - DroppedDown. Для открытия ComboBox напишите:

ComboBox1.DroppedDown := True;

Естественно, False закроет его.

Как программно спрятать/показать заголовок окна (caption)?

Вы можете попробовать следующее:

procedure TForm1.HideTitlebar;

var

Save : Longint;

begin

if BorderStyle = bsNone then Exit;

Save := GetWindowLong(Handle, GWL_STYLE);

if (Save and WS_CAPTION) = WS_CAPTION then

begin

case BorderStyle of

bsSingle, bsSizeable : SetWindowLong(Handle, GWL_STYLE, Save and(Not WS_CAPTION) orWS_BORDER);

bsDialog : SetWindowLong(Handle, GWL_STYLE, Save and (Not WS_CAPTION) or DS_MODALFRAME orWS_DLGFRAME);

end;

Height := Height - GetSystemMetrics(SM_CYCAPTION);

Refresh;

end;

procedure TForm1.ShowTitlebar;

var

Save : Longint;

begin

if BorderStyle = bsNone then Exit;

Save := GetWindowLong(Handle, GWL_STYLE);

if (Save and WS_CAPTION) <> WS_CAPTION then

begin

case BorderStyle of

bsSingle, bsSizeable : SetWindowLong(Handle, GWL_STYLE, Save or WS_CAPTION or WS_BORDER);

bsDialog : SetWindowLong(Handle, GWL_STYLE, Save or WS_CAPTION or DS_MODALFRAME or WS_DLGFRAME);

end;

Height := Height + getSystemMetrics(SM_CYCAPTION);

Refresh;

end;

Как убрать заголовок(caption) из MDI child?

Для MDI child установка свойства BorderStyle = bsNone НЕ убирает заголовок. Это можно сделать так:

procedure TMDIChildForm.CreateParams(var Params : TCreateParams);

begin

inherited;

Params.Style := Params.Style and (not WS_CAPTION);

end;

Ok, пара предложений на эту тему:

a) Создайте форму, занимающую весь экран (maximized) без системных кнопок (maximize, minimize, system).

b) В обработчике FormDeactivate для формы вызовите метод setFocus - это предотвратит
Ctrl + Esc: Form1.SetFocus;

c) В обработчике события FormActivate, нужно присвоить метод Deactivate для приложения :
Application.onDeactivate := FormDeactivate;

d) Создайте всплывающее меню (popup) с единственным пунктом. В свойствах данного пункта нужно установить Visible = False. Создайте процедуру для этого пункта меню, делающую что-нибудь тривиальное типа x := 1 (для того, чтобы Delphi не удалил эту процедуру).

e) Присвойте созданное Popup меню форме (свойство Popupmenu).

f) Задайте горячую клавишу (shortcut) для Popup меню в методе FormActivate как показано ниже:
NullItem1.shortcut := ShortCut(VK_Tab, [ssAlt]);

(!!!: NullItem1 нужно заменить на название созданного вами объекта - пункта меню)

Шаги d, e и f предотвращают Alt-Tab.

Прокрутка Memo (постранично), фокус находится на Edit1.

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

if Key = VK_F8 then

SendMessage(Memo1.Handle, { HWND для Memo }

WM_VSCROLL, { сообщение Windows }

SB_PAGEDOWN, {на страницу вниз }

0) { не используется }

else

if Key = VK_F7 then

SendMessage(Memo1.Handle, WM_VSCROLL, SB_PAGEUP, 0);

end;

Как сделать окно, которое перетаскивается не за заголовок (caption), а за все поле.

Нужно обрабатывать сообщение WM_NCHITTEST:

TForm1 = class(TForm)
...
private
...
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
...
end;

...

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);

begin

inherited; { вызов унаследованного обработчика }

if M.Result = htClient then{ Мышь сидит на окне? }

M.Result := htCaption; { Если да - то пусть Windows думает, что мышь на caption bar }

end;

...

Окно можно сделать вообще без caption.

Как поместить BitMap в меню?

Может быть так:

var Bmp1 : TBitmap;
...

Bmp1 := TBitmap.Create;
Bmp1.LoadFromFile('C:\Where\B1.BMP');
SetMenuItemBitmaps( MenuItemTest.Handle, 0, MF_BYPOSITION, Bmp1.Handle, Bmp1.Handle);
...

Параметры:

- MenuItemTest - имя пункта меню /горизонтальная строка/.
- 0,1 ... позиция пункта меню, в который надо вставить BMP.
- первый из двух handl'ов - для показа невыбранного пункта меню (unchecked).
- второй - для выбранного (checked). Они могут быть разные.

Код можно вставить в обработчик OnCreate для формы.

!!! При уничтожении меню BitMap не уничтожается, это надо делать отдельно.

Оглавление
Назад